home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gnat1792.zip / gnat179b / t-adainc / s-taspda.adb < prev    next >
Text File  |  1994-05-19  |  5KB  |  145 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --            S Y S T E M . T A S K _ S P E C I F I C _ D A T A             --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.3 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. --
  22. --                                                                          --
  23. ------------------------------------------------------------------------------
  24.  
  25. with System.Secondary_Stack;
  26. with Unchecked_Conversion;
  27. with Unchecked_Deallocation;
  28.  
  29. with System.Tasking_Soft_Links; use System.Tasking_Soft_Links;
  30.  
  31. pragma Elaborate (System.Secondary_Stack);
  32. --  This pragma elaborate is required to ensure that the body of package
  33. --  System.Secondary_Stack has been elaborated, so that procedure SS_Init
  34. --  can be called from the elaboration routine of our package body. Note
  35. --  that replacing this by Elaborate_All does not work, since we have
  36. --  carefully arranged that SS_Init does not call us indirectly, but
  37. --  other subprograms in Secondary_Stack do call routines in this package,
  38. --  so an elaboration circularity would result.
  39.  
  40. package body System.Task_Specific_Data is
  41.  
  42.    type TSD is record
  43.       Jmpbuf_Address : Address := Null_Address;
  44.       GNAT_Exception : Address := Null_Address;
  45.       Sec_Stack_Addr : Address := Null_Address;
  46.    end record;
  47.  
  48.    type TSD_Ptr is access TSD;
  49.  
  50.    function From_Address is new
  51.      Unchecked_Conversion (Address, TSD_Ptr);
  52.  
  53.    function To_Address is new
  54.      Unchecked_Conversion (TSD_Ptr, Address);
  55.  
  56.    ------------------------
  57.    -- Get_Jmpbuf_Address --
  58.    ------------------------
  59.  
  60.    function Get_Jmpbuf_Address return  Address is
  61.    begin
  62.       return From_Address (Get_TSD_Address (True)).Jmpbuf_Address;
  63.    end Get_Jmpbuf_Address;
  64.  
  65.    ------------------------
  66.    -- Set_Jmpbuf_Address --
  67.    ------------------------
  68.  
  69.    procedure Set_Jmpbuf_Address (Addr : Address) is
  70.    begin
  71.       From_Address (Get_TSD_Address (True)).Jmpbuf_Address := Addr;
  72.    end Set_Jmpbuf_Address;
  73.  
  74.    ------------------------
  75.    -- Get_GNAT_Exception --
  76.    ------------------------
  77.  
  78.    function Get_GNAT_Exception return  Address is
  79.    begin
  80.       return From_Address (Get_TSD_Address (True)).GNAT_Exception;
  81.    end Get_GNAT_Exception;
  82.  
  83.    ------------------------
  84.    -- Set_GNAT_Exception --
  85.    ------------------------
  86.  
  87.    procedure Set_GNAT_Exception (Addr : Address) is
  88.    begin
  89.       From_Address (Get_TSD_Address (True)).GNAT_Exception := Addr;
  90.    end Set_GNAT_Exception;
  91.  
  92.    ------------------------
  93.    -- Get_Sec_Stack_Addr --
  94.    ------------------------
  95.  
  96.    function Get_Sec_Stack_Addr return  Address is
  97.    begin
  98.       return From_Address (Get_TSD_Address (True)).Sec_Stack_Addr;
  99.    end Get_Sec_Stack_Addr;
  100.  
  101.    ------------------------
  102.    -- Set_Sec_Stack_Addr --
  103.    ------------------------
  104.  
  105.    procedure Set_Sec_Stack_Addr (Addr : Address) is
  106.    begin
  107.       From_Address (Get_TSD_Address (True)).Sec_Stack_Addr := Addr;
  108.    end Set_Sec_Stack_Addr;
  109.  
  110.    ----------------
  111.    -- Create_TSD --
  112.    ----------------
  113.  
  114.    function Create_TSD return Address is
  115.       New_TSD : constant TSD_Ptr := new TSD;
  116.  
  117.    begin
  118.       System.Secondary_Stack.SS_Init (New_TSD.Sec_Stack_Addr, 10*1024);
  119.       --  Allocate 10K secondary stack
  120.  
  121.       return To_Address (New_TSD);
  122.    end Create_TSD;
  123.  
  124.    -----------------
  125.    -- Destroy_TSD --
  126.    -----------------
  127.  
  128.    procedure Destroy_TSD (TSD_Addr : Address) is
  129.       Old_TSD : TSD_Ptr := From_Address (TSD_Addr);
  130.  
  131.       procedure Free is new
  132.         Unchecked_Deallocation (TSD, TSD_Ptr);
  133.  
  134.    begin
  135.       System.Secondary_Stack.SS_Free (Old_TSD.Sec_Stack_Addr);
  136.       Free (Old_TSD);
  137.    end Destroy_TSD;
  138.  
  139. begin
  140.    --  Intialize the TSD for the non-tasking case
  141.  
  142.    Non_Tasking_TSD := Create_TSD;
  143.  
  144. end System.Task_Specific_Data;
  145.